home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / LgcyPlus / disk2 / CALCULAT._ / CALCULAT.
Encoding:
Text File  |  2001-03-02  |  31.1 KB  |  811 lines
  1. 10    ! **********************************************************
  2. 20    ! Example: Calculator
  3. 30    !
  4. 40    ! This program creates a calculator using PUSHBUTTON widgets.
  5. 50    !
  6. 60    ! **********************************************************
  7. 70    !
  8. 80    COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(100)
  9. 90    ASSIGN @Calc TO WIDGET "PANEL";SET ("TITLE":" Example: Calculator","X":20,"Y":20,"WIDTH":300,"HEIGHT":400)
  10. 100   STATUS @Calc;RETURN ("INSIDE WIDTH":Iw)
  11. 110   CONTROL @Calc;SET ("SYSTEM MENU":"Quit")
  12. 120   ON EVENT @Calc,"SYSTEM MENU" GOTO Finis
  13. 130   ASSIGN @Display TO WIDGET "LABEL";SET ("X":5,"Y":5,"WIDTH":Iw-10,"HEIGHT":40,"BACKGROUND":0,"PEN":2,"VALUE":0,"JUSTIFICATION":"RIGHT"),PARENT @Calc
  14. 140   Xpos=5
  15. 150   Ypos=80
  16. 160   Item=1
  17. 170   RAD
  18. 180   ON EVENT @Calc,"RESIZED" GOSUB Resized
  19. 190   DIM Val$[64],Tmp$[64]
  20. 200   DIM Modes$(1:2)[80]
  21. 210   REAL Mem(10)
  22. 220   Modes$(1)="DEGREES"
  23. 230   Modes$(2)="RADIANS"
  24. 240   Val$=""
  25. 250   Fkey=0
  26. 260   Max_stack=100
  27. 270   Stack_ptr=0
  28. 280   Base=10
  29. 290   Store_mode=0
  30. 300   Recall_mode=0
  31. 310   !
  32. 320   ASSIGN @Button10 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  33. 330   ASSIGN @Label10 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  34. 340   CONTROL @Button10;SET ("BACKGROUND":6,"PEN":1,"LABEL":"7","VISIBLE":1)
  35. 350   CONTROL @Label10;SET ("PEN":0,"VALUE":"A")
  36. 360   ASSIGN @Button11 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  37. 370   ASSIGN @Label11 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  38. 380   CONTROL @Button11;SET ("BACKGROUND":6,"PEN":1,"LABEL":"4","VISIBLE":1)
  39. 390   CONTROL @Label11;SET ("PEN":0,"VALUE":"D")
  40. 400   ASSIGN @Button12 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  41. 410   ASSIGN @Label12 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  42. 420   CONTROL @Button12;SET ("BACKGROUND":6,"PEN":1,"LABEL":"1","VISIBLE":1)
  43. 430   CONTROL @Label12;SET ("PEN":0,"VALUE":"","VISIBLE":1)
  44. 440   ASSIGN @Button13 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  45. 450   ASSIGN @Label13 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  46. 460   CONTROL @Button13;SET ("BACKGROUND":6,"PEN":1,"LABEL":"0","VISIBLE":1)
  47. 470   CONTROL @Label13;SET ("PEN":0,"VALUE":"STO","VISIBLE":1)
  48. 480   ASSIGN @Button14 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+4*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  49. 490   ASSIGN @Label14 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+4*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  50. 500   CONTROL @Button14;SET ("WIDTH":(Iw-20)/2.5-10)
  51. 510   CONTROL @Label14;SET ("WIDTH":(Iw-20)/2.5-10)
  52. 520   CONTROL @Button14;SET ("BACKGROUND":6,"PEN":1,"LABEL":"ENTER","VISIBLE":1)
  53. 530   CONTROL @Label14;SET ("PEN":0,"VALUE":"QUIT","VISIBLE":1)
  54. 540   ASSIGN @Button15 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  55. 550   ASSIGN @Label15 TO WIDGET "LABEL";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  56. 560   CONTROL @Button15;SET ("BACKGROUND":6,"PEN":1,"LABEL":"8","VISIBLE":1)
  57. 570   CONTROL @Label15;SET ("PEN":0,"VALUE":"B")
  58. 580   ASSIGN @Button16 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  59. 590   ASSIGN @Label16 TO WIDGET "LABEL";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  60. 600   CONTROL @Button16;SET ("BACKGROUND":6,"PEN":1,"LABEL":"5","VISIBLE":1)
  61. 610   CONTROL @Label16;SET ("PEN":0,"VALUE":"E")
  62. 620   ASSIGN @Button17 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  63. 630   ASSIGN @Label17 TO WIDGET "LABEL";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  64. 640   CONTROL @Button17;SET ("BACKGROUND":6,"PEN":1,"LABEL":"2","VISIBLE":1)
  65. 650   CONTROL @Label17;SET ("PEN":0,"VALUE":"e","VISIBLE":1)
  66. 660   ASSIGN @Button18 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  67. 670   ASSIGN @Label18 TO WIDGET "LABEL";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  68. 680   CONTROL @Button18;SET ("BACKGROUND":6,"PEN":1,"LABEL":".","VISIBLE":1)
  69. 690   CONTROL @Label18;SET ("PEN":0,"VALUE":"RCL","VISIBLE":1)
  70. 700   ASSIGN @Button20 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  71. 710   ASSIGN @Label20 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  72. 720   CONTROL @Button20;SET ("BACKGROUND":6,"PEN":1,"LABEL":"9","VISIBLE":1)
  73. 730   CONTROL @Label20;SET ("PEN":0,"VALUE":"C")
  74. 740   ASSIGN @Button21 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  75. 750   ASSIGN @Label21 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  76. 760   CONTROL @Button21;SET ("BACKGROUND":6,"PEN":1,"LABEL":"6","VISIBLE":1)
  77. 770   CONTROL @Label21;SET ("PEN":0,"VALUE":"F")
  78. 780   ASSIGN @Button22 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  79. 790   ASSIGN @Label22 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  80. 800   CONTROL @Button22;SET ("BACKGROUND":6,"PEN":1,"LABEL":"3","VISIBLE":1)
  81. 810   CONTROL @Label22;SET ("PEN":0,"VALUE":"PI","VISIBLE":1)
  82. 820   ASSIGN @Button23 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  83. 830   ASSIGN @Label23 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  84. 840   CONTROL @Button23;SET ("BACKGROUND":6,"PEN":1,"LABEL":"CHS","VISIBLE":1)
  85. 850   CONTROL @Label23;SET ("PEN":0,"VALUE":"ANGL","VISIBLE":1)
  86. 860   ASSIGN @Button24 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+4*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  87. 870   ASSIGN @Label24 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+4*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  88. 880   CONTROL @Button24;SET ("BACKGROUND":6,"PEN":1,"LABEL":"CLX","VISIBLE":1)
  89. 890   CONTROL @Label24;SET ("PEN":0,"VALUE":"","VISIBLE":1)
  90. 900   ASSIGN @Button25 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  91. 910   ASSIGN @Label25 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  92. 920   CONTROL @Button25;SET ("BACKGROUND":6,"PEN":1,"LABEL":"/","VISIBLE":1)
  93. 930   CONTROL @Label25;SET ("PEN":0,"VALUE":"HEX","VISIBLE":1)
  94. 940   ASSIGN @Button26 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  95. 950   ASSIGN @Label26 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  96. 960   CONTROL @Button26;SET ("BACKGROUND":6,"PEN":1,"LABEL":"*","VISIBLE":1)
  97. 970   CONTROL @Label26;SET ("PEN":0,"VALUE":"DEC","VISIBLE":1)
  98. 980   ASSIGN @Button27 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  99. 990   ASSIGN @Label27 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  100. 1000  CONTROL @Button27;SET ("BACKGROUND":6,"PEN":1,"LABEL":"-","VISIBLE":1)
  101. 1010  CONTROL @Label27;SET ("PEN":0,"VALUE":"OCT","VISIBLE":1)
  102. 1020  ASSIGN @Button28 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  103. 1030  ASSIGN @Label28 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  104. 1040  CONTROL @Button28;SET ("BACKGROUND":6,"PEN":1,"LABEL":"+","VISIBLE":1)
  105. 1050  CONTROL @Label28;SET ("PEN":0,"VALUE":"BIN","VISIBLE":1)
  106. 1060  ASSIGN @Button29 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+4*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  107. 1070  ASSIGN @Label29 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+4*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  108. 1080  CONTROL @Button29;SET ("BACKGROUND":6,"PEN":1,"LABEL":"f","VISIBLE":1)
  109. 1090  CONTROL @Label29;SET ("PEN":0,"VALUE":"","VISIBLE":1)
  110. 1100  CONTROL @Button29;SET ("BACKGROUND":3,"PEN":0)
  111. 1110  ASSIGN @Button30 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  112. 1120  ASSIGN @Label30 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  113. 1130  CONTROL @Button30;SET ("BACKGROUND":6,"PEN":1,"LABEL":"SIN","VISIBLE":1)
  114. 1140  CONTROL @Label30;SET ("PEN":0,"VALUE":"ASN","VISIBLE":1)
  115. 1150  ASSIGN @Button31 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  116. 1160  ASSIGN @Label31 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  117. 1170  CONTROL @Button31;SET ("BACKGROUND":6,"PEN":1,"LABEL":"COS","VISIBLE":1)
  118. 1180  CONTROL @Label31;SET ("PEN":0,"VALUE":"ACS","VISIBLE":1)
  119. 1190  ASSIGN @Button32 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  120. 1200  ASSIGN @Label32 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  121. 1210  CONTROL @Button32;SET ("BACKGROUND":6,"PEN":1,"LABEL":"TAN","VISIBLE":1)
  122. 1220  CONTROL @Label32;SET ("PEN":0,"VALUE":"ATN","VISIBLE":1)
  123. 1230  ASSIGN @Button33 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  124. 1240  ASSIGN @Label33 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  125. 1250  CONTROL @Button33;SET ("BACKGROUND":6,"PEN":1,"LABEL":"10^X","VISIBLE":1)
  126. 1260  CONTROL @Label33;SET ("PEN":0,"VALUE":"LOG","VISIBLE":1)
  127. 1270  ASSIGN @Button34 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+4*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
  128. 1280  ASSIGN @Label34 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+4*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
  129. 1290  CONTROL @Button34;SET ("BACKGROUND":6,"PEN":1,"LABEL":"EEX","VISIBLE":1)
  130. 1300  CONTROL @Label34;SET ("PEN":0,"VALUE":"LN","VISIBLE":1)
  131. 1310  ON ERROR GOTO Process_error
  132. 1320  ON EVENT @Button10,"ACTIVATED" GOSUB Button10
  133. 1330  CONTROL @Label16;SET ("VISIBLE":1)
  134. 1340  ON EVENT @Button11,"ACTIVATED" GOSUB Button11
  135. 1350  ON EVENT @Button12,"ACTIVATED" GOSUB Button12
  136. 1360  ON EVENT @Button13,"ACTIVATED" GOSUB Button13
  137. 1370  ON EVENT @Button14,"ACTIVATED" GOSUB Button14
  138. 1380  ON EVENT @Button15,"ACTIVATED" GOSUB Button15
  139. 1390  ON EVENT @Button16,"ACTIVATED" GOSUB Button16
  140. 1400  ON EVENT @Button17,"ACTIVATED" GOSUB Button17
  141. 1410  ON EVENT @Button18,"ACTIVATED" GOSUB Button18
  142. 1420  ON EVENT @Button20,"ACTIVATED" GOSUB Button20
  143. 1430  ON EVENT @Button21,"ACTIVATED" GOSUB Button21
  144. 1440  ON EVENT @Button22,"ACTIVATED" GOSUB Button22
  145. 1450  ON EVENT @Button23,"ACTIVATED" GOSUB Button23
  146. 1460  ON EVENT @Button24,"ACTIVATED" GOSUB Button24
  147. 1470  ON EVENT @Button25,"ACTIVATED" GOSUB Button25
  148. 1480  ON EVENT @Button26,"ACTIVATED" GOSUB Button26
  149. 1490  ON EVENT @Button27,"ACTIVATED" GOSUB Button27
  150. 1500  ON EVENT @Button28,"ACTIVATED" GOSUB Button28
  151. 1510  ON EVENT @Button29,"ACTIVATED" GOSUB Button29
  152. 1520  ON EVENT @Button30,"ACTIVATED" GOSUB Button30
  153. 1530  ON EVENT @Button31,"ACTIVATED" GOSUB Button31
  154. 1540  ON EVENT @Button32,"ACTIVATED" GOSUB Button32
  155. 1550  ON EVENT @Button33,"ACTIVATED" GOSUB Button33
  156. 1560  ON EVENT @Button34,"ACTIVATED" GOSUB Button34
  157. 1570  LOOP
  158. 1580    WAIT FOR EVENT
  159. 1590  END LOOP
  160. 1600 Button10:     !
  161. 1610  Number=7
  162. 1620  GOSUB Check_storcl
  163. 1630  IF Store_mode=0 AND Recall_mode=0 THEN
  164. 1640    GOSUB Getval
  165. 1650    IF Fkey=0 OR Base<>16 THEN
  166. 1660      Modval(Val$,Number)
  167. 1670    ELSE
  168. 1680      Modval(Val$,0,"A")
  169. 1690    END IF
  170. 1700    CONTROL @Display;SET ("VALUE":Val$)
  171. 1710  ELSE
  172. 1720    GOSUB Enable_base
  173. 1730  END IF
  174. 1740  GOSUB Check_fkey
  175. 1750  RETURN
  176. 1760 Button11:     !
  177. 1770  Number=4
  178. 1780  GOSUB Check_storcl
  179. 1790  IF Store_mode=0 AND Recall_mode=0 THEN
  180. 1800    GOSUB Getval
  181. 1810    IF Fkey=0 OR Base<>16 THEN
  182. 1820      Modval(Val$,Number)
  183. 1830    ELSE
  184. 1840      Modval(Val$,0,"D")
  185. 1850    END IF
  186. 1860    CONTROL @Display;SET ("VALUE":Val$)
  187. 1870  ELSE
  188. 1880    GOSUB Enable_base
  189. 1890  END IF
  190. 1900  GOSUB Check_fkey
  191. 1910  RETURN
  192. 1920 Button12:     !
  193. 1930  Number=1
  194. 1940  GOSUB Check_storcl
  195. 1950  IF Store_mode=0 AND Recall_mode=0 THEN
  196. 1960    GOSUB Getval
  197. 1970    Modval(Val$,Number)
  198. 1980    CONTROL @Display;SET ("VALUE":Val$)
  199. 1990  ELSE
  200. 2000    GOSUB Enable_base
  201. 2010  END IF
  202. 2020  GOSUB Check_fkey
  203. 2030  RETURN
  204. 2040 Button13:     !
  205. 2050  Number=0
  206. 2060  GOSUB Check_storcl
  207. 2070  IF Store_mode=0 AND Recall_mode=0 THEN
  208. 2080    GOSUB Getval
  209. 2090    IF Fkey=0 THEN
  210. 2100      Modval(Val$,Number)
  211. 2110    ELSE
  212. 2120      Store_mode=1
  213. 2130      GOSUB Enable_all
  214. 2140      GOSUB Clear_fn_keys
  215. 2150      GOSUB Clear_hex_keys
  216. 2160      RETURN
  217. 2170    END IF
  218. 2180    CONTROL @Display;SET ("VALUE":Val$)
  219. 2190  ELSE
  220. 2200    GOSUB Enable_base
  221. 2210  END IF
  222. 2220  GOSUB Check_fkey
  223. 2230  RETURN
  224. 2240 Button14:     !
  225. 2250  IF Fkey=0 THEN
  226. 2260    Get_dispval(@Display,Base,Val)
  227. 2270    Push_val(Val,@Display)
  228. 2280    Restart=1
  229. 2290  ELSE
  230. 2300    STOP
  231. 2310  END IF
  232. 2320  GOSUB Check_fkey
  233. 2330  RETURN
  234. 2340 Button15:     !
  235. 2350  Number=8
  236. 2360  GOSUB Check_storcl
  237. 2370  IF Store_mode=0 AND Recall_mode=0 THEN
  238. 2380    GOSUB Getval
  239. 2390    IF Fkey=0 OR Base<>16 THEN
  240. 2400      Modval(Val$,Number)
  241. 2410    ELSE
  242. 2420      Modval(Val$,0,"B")
  243. 2430    END IF
  244. 2440    CONTROL @Display;SET ("VALUE":Val$)
  245. 2450  ELSE
  246. 2460    GOSUB Enable_base
  247. 2470  END IF
  248. 2480  GOSUB Check_fkey
  249. 2490  RETURN
  250. 2500 Button16:     !
  251. 2510  Number=5
  252. 2520  GOSUB Check_storcl
  253. 2530  IF Store_mode=0 AND Recall_mode=0 THEN
  254. 2540    GOSUB Getval
  255. 2550    IF Fkey=0 OR (Base<>16 AND Base<>10) THEN
  256. 2560      Modval(Val$,Number)
  257. 2570    ELSE
  258. 2580      IF Base=10 THEN
  259. 2590        GOSUB Process_e
  260. 2600      ELSE
  261. 2610        Modval(Val$,0,"E")
  262. 2620      END IF
  263. 2630    END IF
  264. 2640    CONTROL @Display;SET ("VALUE":Val$)
  265. 2650  ELSE
  266. 2660    GOSUB Enable_base
  267. 2670  END IF
  268. 2680  GOSUB Check_fkey
  269. 2690  RETURN
  270. 2700 Button17:      !
  271. 2710  Number=2
  272. 2720  GOSUB Check_storcl
  273. 2730  IF Store_mode=0 AND Recall_mode=0 THEN
  274. 2740    GOSUB Getval
  275. 2750    IF Fkey=0 THEN
  276. 2760      Modval(Val$,Number)
  277. 2770    ELSE
  278. 2780      Tentobase(Base,EXP(1),Val$,Error)
  279. 2790    END IF
  280. 2800    CONTROL @Display;SET ("VALUE":Val$)
  281. 2810  ELSE
  282. 2820    GOSUB Enable_base
  283. 2830  END IF
  284. 2840  GOSUB Check_fkey
  285. 2850  RETURN
  286. 2860 Button18:      !
  287. 2870  IF Fkey=0 THEN
  288. 2880    STATUS @Display;RETURN ("VALUE":Val$)
  289. 2890    IF (POS(Val$,".")=0) THEN Val$=Val$&"."
  290. 2900    CONTROL @Display;SET ("VALUE":Val$)
  291. 2910  ELSE
  292. 2920    Recall_mode=1
  293. 2930    GOSUB Enable_all
  294. 2940    GOSUB Clear_fn_keys
  295. 2950    GOSUB Clear_hex_keys
  296. 2960  END IF
  297. 2970  GOSUB Check_fkey
  298. 2980  RETURN
  299. 2990 Button19:      !
  300. 3000 Button20:      !
  301. 3010  Number=9
  302. 3020  GOSUB Check_storcl
  303. 3030  IF Store_mode=0 AND Recall_mode=0 THEN
  304. 3040    GOSUB Getval
  305. 3050    IF Fkey=0 OR Base<>16 THEN
  306. 3060      Modval(Val$,Number)
  307. 3070    ELSE
  308. 3080      Modval(Val$,0,"C")
  309. 3090    END IF
  310. 3100    CONTROL @Display;SET ("VALUE":Val$)
  311. 3110  ELSE
  312. 3120    GOSUB Enable_base
  313. 3130  END IF
  314. 3140  GOSUB Check_fkey
  315. 3150  RETURN
  316. 3160 Button21:      !
  317. 3170  Number=6
  318. 3180  GOSUB Check_storcl
  319. 3190  IF Store_mode=0 AND Recall_mode=0 THEN
  320. 3200    GOSUB Getval
  321. 3210    IF Fkey=0 OR Base<>16 THEN
  322. 3220      Modval(Val$,Number)
  323. 3230    ELSE
  324. 3240      Modval(Val$,0,"F")
  325. 3250    END IF
  326. 3260    CONTROL @Display;SET ("VALUE":Val$)
  327. 3270  ELSE
  328. 3280    GOSUB Enable_base
  329. 3290  END IF
  330. 3300  GOSUB Check_fkey
  331. 3310  RETURN
  332. 3320 Button22:      !
  333. 3330  Number=3
  334. 3340  GOSUB Check_storcl
  335. 3350  IF Store_mode=0 AND Recall_mode=0 THEN
  336. 3360    GOSUB Getval
  337. 3370    IF Fkey=0 THEN
  338. 3380      Modval(Val$,Number)
  339. 3390    ELSE
  340. 3400      Tentobase(Base,PI,Val$,Error)
  341. 3410    END IF
  342. 3420    CONTROL @Display;SET ("VALUE":Val$)
  343. 3430  ELSE
  344. 3440    GOSUB Enable_base
  345. 3450  END IF
  346. 3460  GOSUB Check_fkey
  347. 3470  RETURN
  348. 3480 Button23:      !
  349. 3490  IF Fkey=0 THEN
  350. 3500    STATUS @Display;RETURN ("VALUE":Val$)
  351. 3510    IF Base=10 THEN
  352. 3520      IF Val$[1;1]="-" THEN
  353. 3530        Val$=Val$[2]
  354. 3540      ELSE
  355. 3550        Val$="-"&Val$
  356. 3560      END IF
  357. 3570    ELSE
  358. 3580      Twos_comp(Base,Val$)
  359. 3590    END IF
  360. 3600    CONTROL @Display;SET ("VALUE":Val$)
  361. 3610  ELSE
  362. 3620    !* DIALOG "LIST","Trigonometric Mode",Button;SET ("ITEMS":Modes$(*),"SELECTED ITEM":Item),
  363. 3630    IF Button=0 AND Item<>-1 THEN
  364. 3640      IF Item=0 THEN DEG
  365. 3650      IF Item=1 THEN RAD
  366. 3660    END IF
  367. 3670  END IF
  368. 3680  GOSUB Check_fkey
  369. 3690  RETURN
  370. 3700 Button24:      !
  371. 3710  CONTROL @Display;SET ("VALUE":0)
  372. 3720  GOSUB Check_fkey
  373. 3730  RETURN
  374. 3740 Button25:      !
  375. 3750  IF Fkey=0 THEN
  376. 3760    Get_dispval(@Display,Base,Val1)
  377. 3770    Val2=FNPop_val(@Display)
  378. 3780    Val$=VAL$(Val2/Val1)
  379. 3790    Set_dispval(@Display,Base,VAL(Val$))
  380. 3800    Push_val(VAL(Val$),@Display)
  381. 3810    Restart=1
  382. 3820  ELSE
  383. 3830    Get_dispval(@Display,Base,Val1)
  384. 3840    Base=16
  385. 3850    Set_dispval(@Display,Base,Val1)
  386. 3860    CONTROL @Label10;SET ("VISIBLE":1)
  387. 3870    CONTROL @Label11;SET ("VISIBLE":1)
  388. 3880    CONTROL @Label15;SET ("VISIBLE":1)
  389. 3890    CONTROL @Label16;SET ("VISIBLE":1)
  390. 3900    CONTROL @Label20;SET ("VISIBLE":1)
  391. 3910    CONTROL @Label21;SET ("VISIBLE":1)
  392. 3920    GOSUB Enable_all
  393. 3930  END IF
  394. 3940  GOSUB Check_fkey
  395. 3950  RETURN
  396. 3960 Button26:      !
  397. 3970  IF Fkey=0 THEN
  398. 3980    Get_dispval(@Display,Base,Val1)
  399. 3990    Val2=FNPop_val(@Display)
  400. 4000    Val$=VAL$(Val2*Val1)
  401. 4010    Set_dispval(@Display,Base,VAL(Val$))
  402. 4020    Push_val(VAL(Val$),@Display)
  403. 4030    Restart=1
  404. 4040  ELSE
  405. 4050    Get_dispval(@Display,Base,Val1)
  406. 4060    Base=10
  407. 4070    Set_dispval(@Display,Base,Val1)
  408. 4080    GOSUB Enable_all
  409. 4090    GOSUB Clear_hex_keys
  410. 4100    CONTROL @Label16;SET ("VISIBLE":1)
  411. 4110  END IF
  412. 4120  GOSUB Check_fkey
  413. 4130  RETURN
  414. 4140 Button27:      !
  415. 4150  IF Fkey=0 THEN
  416. 4160    Get_dispval(@Display,Base,Val1)
  417. 4170    Val2=FNPop_val(@Display)
  418. 4180    Val$=VAL$(Val2-Val1)
  419. 4190    Set_dispval(@Display,Base,VAL(Val$))
  420. 4200    Push_val(VAL(Val$),@Display)
  421. 4210    Restart=1
  422. 4220  ELSE
  423. 4230    Get_dispval(@Display,Base,Val1)
  424. 4240    Base=8
  425. 4250    Set_dispval(@Display,Base,Val1)
  426. 4260    GOSUB Enable_all
  427. 4270    GOSUB Clear_nonoct
  428. 4280  END IF
  429. 4290  GOSUB Check_fkey
  430. 4300  RETURN
  431. 4310 Button28:      !
  432. 4320  IF Fkey=0 THEN
  433. 4330    Get_dispval(@Display,Base,Val1)
  434. 4340    Val2=FNPop_val(@Display)
  435. 4350    Val$=VAL$(Val1+Val2)
  436. 4360    Push_val(VAL(Val$),@Display)
  437. 4370    Set_dispval(@Display,Base,VAL(Val$))
  438. 4380    Restart=1
  439. 4390  ELSE
  440. 4400    Get_dispval(@Display,Base,Val1)
  441. 4410    Base=2
  442. 4420    Set_dispval(@Display,Base,Val1)
  443. 4430    GOSUB Enable_all
  444. 4440    GOSUB Clear_nonbin
  445. 4450  END IF
  446. 4460  GOSUB Check_fkey
  447. 4470  RETURN
  448. 4480 Button29:      !
  449. 4490  Fkey=(Fkey+1) MOD 2
  450. 4500  IF Fkey=1 THEN
  451. 4510    CONTROL @Display;SET ("PEN":3)
  452. 4520    GOSUB Enable_pi
  453. 4530  ELSE
  454. 4540    CONTROL @Display;SET ("PEN":2)
  455. 4550    GOSUB Enable_base
  456. 4560  END IF
  457. 4570  RETURN
  458. 4580 Button30:      !
  459. 4590  Get_dispval(@Display,Base,Val1)
  460. 4600  IF Fkey=0 THEN
  461. 4610    Val$=VAL$(SIN(Val1))
  462. 4620  ELSE
  463. 4630    Val$=VAL$(ASN(Val1))
  464. 4640  END IF
  465. 4650  Set_dispval(@Display,Base,VAL(Val$))
  466. 4660  Push_val(VAL(Val$),@Display)
  467. 4670  Restart=1
  468. 4680  GOSUB Check_fkey
  469. 4690  RETURN
  470. 4700 Button31:      !
  471. 4710  Get_dispval(@Display,Base,Val1)
  472. 4720  IF Fkey=0 THEN
  473. 4730    Val$=VAL$(COS(Val1))
  474. 4740  ELSE
  475. 4750    Val$=VAL$(ACS(Val1))
  476. 4760  END IF
  477. 4770  Set_dispval(@Display,Base,VAL(Val$))
  478. 4780  Push_val(VAL(Val$),@Display)
  479. 4790  Restart=1
  480. 4800  GOSUB Check_fkey
  481. 4810  RETURN
  482. 4820 Button32:      !
  483. 4830  Get_dispval(@Display,Base,Val1)
  484. 4840  IF Fkey=0 THEN
  485. 4850    Val$=VAL$(TAN(Val1))
  486. 4860  ELSE
  487. 4870    Val$=VAL$(ATN(Val1))
  488. 4880  END IF
  489. 4890  Set_dispval(@Display,Base,VAL(Val$))
  490. 4900  Push_val(VAL(Val$),@Display)
  491. 4910  Restart=1
  492. 4920  GOSUB Check_fkey
  493. 4930  RETURN
  494. 4940 Button33:      !
  495. 4950  Get_dispval(@Display,Base,Val1)
  496. 4960  IF Fkey=0 THEN
  497. 4970    Val$=VAL$(10^Val1)
  498. 4980  ELSE
  499. 4990    Val$=VAL$(LGT(Val1))
  500. 5000  END IF
  501. 5010  Set_dispval(@Display,Base,VAL(Val$))
  502. 5020  Push_val(VAL(Val$),@Display)
  503. 5030  Restart=1
  504. 5040  GOSUB Check_fkey
  505. 5050  RETURN
  506. 5060 Button34:      !
  507. 5070  Get_dispval(@Display,Base,Val1)
  508. 5080  IF Fkey=0 THEN
  509. 5090    Val$=VAL$(EXP(Val1))
  510. 5100  ELSE
  511. 5110    Val$=VAL$(LOG(Val1))
  512. 5120  END IF
  513. 5130  Set_dispval(@Display,Base,VAL(Val$))
  514. 5140  Push_val(VAL(Val$),@Display)
  515. 5150  Restart=1
  516. 5160  GOSUB Check_fkey
  517. 5170  RETURN
  518. 5180 Clear_nonbin:  !
  519. 5190  CONTROL @Button17;SET ("SENSITIVE":0)
  520. 5200  CONTROL @Button22;SET ("SENSITIVE":0)
  521. 5210  CONTROL @Button11;SET ("SENSITIVE":0)
  522. 5220  CONTROL @Button16;SET ("SENSITIVE":0)
  523. 5230  CONTROL @Button21;SET ("SENSITIVE":0)
  524. 5240  CONTROL @Button10;SET ("SENSITIVE":0)
  525. 5250 Clear_nonoct:  !
  526. 5260  CONTROL @Button15;SET ("SENSITIVE":0)
  527. 5270  CONTROL @Button20;SET ("SENSITIVE":0)
  528. 5280 Clear_hex_keys:  !
  529. 5290  CONTROL @Label10;SET ("VISIBLE":0)
  530. 5300  CONTROL @Label11;SET ("VISIBLE":0)
  531. 5310  CONTROL @Label15;SET ("VISIBLE":0)
  532. 5320  CONTROL @Label16;SET ("VISIBLE":0)
  533. 5330  CONTROL @Label20;SET ("VISIBLE":0)
  534. 5340  CONTROL @Label21;SET ("VISIBLE":0)
  535. 5350  RETURN
  536. 5360 Clear_fn_keys:  !
  537. 5370  CONTROL @Button29;SET ("SENSITIVE":0)
  538. 5380  CONTROL @Button23;SET ("SENSITIVE":0)
  539. 5390  CONTROL @Button30;SET ("SENSITIVE":0)
  540. 5400  CONTROL @Button32;SET ("SENSITIVE":0)
  541. 5410  CONTROL @Button31;SET ("SENSITIVE":0)
  542. 5420  CONTROL @Button24;SET ("SENSITIVE":0)
  543. 5430  CONTROL @Button34;SET ("SENSITIVE":0)
  544. 5440  CONTROL @Button33;SET ("SENSITIVE":0)
  545. 5450  CONTROL @Button26;SET ("SENSITIVE":0)
  546. 5460  CONTROL @Button14;SET ("SENSITIVE":0)
  547. 5470  CONTROL @Button28;SET ("SENSITIVE":0)
  548. 5480  CONTROL @Button27;SET ("SENSITIVE":0)
  549. 5490  CONTROL @Button18;SET ("SENSITIVE":0)
  550. 5500  CONTROL @Button25;SET ("SENSITIVE":0)
  551. 5510  RETURN
  552. 5520 Enable_all:  !
  553. 5530  CONTROL @Button13;SET ("SENSITIVE":1)
  554. 5540  CONTROL @Button12;SET ("SENSITIVE":1)
  555. 5550  CONTROL @Button17;SET ("SENSITIVE":1)
  556. 5560  CONTROL @Button22;SET ("SENSITIVE":1)
  557. 5570  CONTROL @Button11;SET ("SENSITIVE":1)
  558. 5580  CONTROL @Button16;SET ("SENSITIVE":1)
  559. 5590  CONTROL @Button21;SET ("SENSITIVE":1)
  560. 5600  CONTROL @Button10;SET ("SENSITIVE":1)
  561. 5610  CONTROL @Button15;SET ("SENSITIVE":1)
  562. 5620  CONTROL @Button20;SET ("SENSITIVE":1)
  563. 5630  CONTROL @Button29;SET ("SENSITIVE":1)
  564. 5640  CONTROL @Button23;SET ("SENSITIVE":1)
  565. 5650  CONTROL @Button30;SET ("SENSITIVE":1)
  566. 5660  CONTROL @Button32;SET ("SENSITIVE":1)
  567. 5670  CONTROL @Button31;SET ("SENSITIVE":1)
  568. 5680  CONTROL @Button24;SET ("SENSITIVE":1)
  569. 5690  CONTROL @Button34;SET ("SENSITIVE":1)
  570. 5700  CONTROL @Button33;SET ("SENSITIVE":1)
  571. 5710  CONTROL @Button26;SET ("SENSITIVE":1)
  572. 5720  CONTROL @Button14;SET ("SENSITIVE":1)
  573. 5730  CONTROL @Button28;SET ("SENSITIVE":1)
  574. 5740  CONTROL @Button27;SET ("SENSITIVE":1)
  575. 5750  CONTROL @Button18;SET ("SENSITIVE":1)
  576. 5760  CONTROL @Button25;SET ("SENSITIVE":1)
  577. 5770  RETURN
  578. 5780 Enable_e:     !
  579. 5790  CONTROL @Label16;SET ("VISIBLE":1)
  580. 5800  RETURN
  581. 5810 Enable_pi:     !
  582. 5820  CONTROL @Button22;SET ("SENSITIVE":1)
  583. 5830  CONTROL @Button17;SET ("SENSITIVE":1)
  584. 5840  RETURN
  585. 5850 Enable_base:   !
  586. 5860  Recall_mode=0
  587. 5870  Store_mode=0
  588. 5880  GOSUB Enable_all
  589. 5890  IF Base=2 THEN GOSUB Clear_nonbin
  590. 5900  IF Base=8 THEN GOSUB Clear_nonoct
  591. 5910  IF Base=10 THEN
  592. 5920    GOSUB Clear_hex_keys
  593. 5930    GOSUB Enable_e
  594. 5940  END IF
  595. 5950  RETURN
  596. 5960 Check_storcl: !
  597. 5970  IF Store_mode THEN
  598. 5980    Get_dispval(@Display,Base,Val1)
  599. 5990    Mem(Number)=Val1
  600. 6000  ELSE
  601. 6010    IF Recall_mode THEN
  602. 6020      Val1=Mem(Number)
  603. 6030      Set_dispval(@Display,Base,Val1)
  604. 6040    END IF
  605. 6050  END IF
  606. 6060  RETURN
  607. 6070 Resized: RETURN
  608. 6080 Process_e: !
  609. 6090  IF (POS(Val$,"E")=0) THEN Val$=Val$&"E"
  610. 6100  RETURN
  611. 6110 Process_error: !
  612. 6120  IF Fkey=1 THEN CONTROL @Display;SET ("PEN":2)
  613. 6130  Fkey=0
  614. 6140  STATUS @Display;RETURN ("VALUE":Tmp$)
  615. 6150  CONTROL @Display;SET ("VALUE":ERRM$)
  616. 6160  WAIT 2
  617. 6170  CONTROL @Display;SET ("VALUE":Tmp$)
  618. 6180  RETURN
  619. 6190 Getval: !
  620. 6200  IF Restart THEN
  621. 6210    Restart=0
  622. 6220    Val$="0"
  623. 6230  ELSE
  624. 6240    STATUS @Display;RETURN ("VALUE":Val$)
  625. 6250  END IF
  626. 6260  RETURN
  627. 6270 Check_fkey: !
  628. 6280  IF Fkey=1 THEN
  629. 6290    CONTROL @Display;SET ("PEN":2)
  630. 6300    GOSUB Enable_base
  631. 6310  END IF
  632. 6320  Fkey=0
  633. 6330  RETURN
  634. 6340 Finis: END
  635. 6350  !     
  636. 6360  SUB Push_val(REAL Val,@Disp)
  637. 6370    COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(*)
  638. 6380    Stack(Stack_ptr)=Val
  639. 6390    IF Stack_ptr<=Max_stack THEN
  640. 6400      Stack_ptr=Stack_ptr+1
  641. 6410    ELSE
  642. 6420      BEEP
  643. 6430      STATUS @Disp;RETURN ("VALUE":Tmpval$)
  644. 6440      CONTROL @Disp;SET ("VALUE":"ERROR: STACK OVERFLOW!!!")
  645. 6450      WAIT 2
  646. 6460      CONTROL @Disp;SET ("VALUE":Tmpval$)
  647. 6470      SUBEXIT
  648. 6480    END IF
  649. 6490  SUBEND
  650. 6500  DEF FNPop_val(@Disp)
  651. 6510    COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(*)
  652. 6520    IF Stack_ptr>0 THEN
  653. 6530      Stack_ptr=Stack_ptr-1
  654. 6540    ELSE
  655. 6550      BEEP
  656. 6560      STATUS @Disp;RETURN ("VALUE":Tmpval$)
  657. 6570      CONTROL @Disp;SET ("VALUE":"ERROR: STACK UNDERFLOW!!!")
  658. 6580      WAIT 2
  659. 6590      CONTROL @Disp;SET ("VALUE":Tmpval$)
  660. 6600      RETURN 0
  661. 6610    END IF
  662. 6620    RETURN Stack(Stack_ptr)
  663. 6630  FNEND
  664. 6640  DEF FNGetval(A$)
  665. 6650    IF NUM(A$)>=NUM("0") AND NUM(A$)<=NUM("9") THEN
  666. 6660      RETURN VAL(A$)
  667. 6670    ELSE
  668. 6680      RETURN NUM(A$)-55
  669. 6690    END IF
  670. 6700  FNEND
  671. 6710  DEF FNGetval$(A)
  672. 6720    IF A>=10 THEN
  673. 6730      RETURN CHR$(A+NUM("A")-10)
  674. 6740    ELSE
  675. 6750      RETURN VAL$(A)
  676. 6760    END IF
  677. 6770  FNEND
  678. 6780  SUB Basetoten(Base,Value,Str$)
  679. 6790    IF Base=10 THEN
  680. 6800      Value=VAL(Str$)
  681. 6810      SUBEXIT
  682. 6820    END IF
  683. 6830    Sign=0
  684. 6840    IF LEN(Str$)=MAXLEN(Str$) AND FNGetval$(Base-1)=Str$[1;1] THEN
  685. 6850      Sign=1
  686. 6860      Twos_comp(Base,Str$)
  687. 6870    END IF
  688. 6880    Value=0.
  689. 6890    Max=LEN(Str$)
  690. 6900    IF POS(Str$,".")<>0 THEN Max=POS(Str$,".")-1
  691. 6910    FOR I=1 TO Max
  692. 6920      Value=Base*Value+FNGetval(Str$[I;1])
  693. 6930    NEXT I
  694. 6940    IF POS(Str$,".")<>0 THEN
  695. 6950      J=0
  696. 6960      FOR I=Max+2 TO LEN(Str$)
  697. 6970        J=J+1
  698. 6980        Value=Value+FNGetval(Str$[I;1])*Base^(-J)
  699. 6990      NEXT I
  700. 7000    END IF
  701. 7010    IF Sign=1 THEN
  702. 7020      Value=-Value
  703. 7030      Twos_comp(Base,Str$)
  704. 7040    END IF
  705. 7050  SUBEND
  706. 7060  SUB Tentobase(Base,Value,Str$,Error)
  707. 7070    Error=0
  708. 7080    Str$=""
  709. 7090    IF Base=10 THEN
  710. 7100      Str$=VAL$(Value)
  711. 7110      SUBEXIT
  712. 7120    END IF
  713. 7130    Sign=0
  714. 7140    IF Value<0 THEN
  715. 7150      Sign=1
  716. 7160      Value=-Value
  717. 7170    END IF
  718. 7180    Divisor1=Value DIV 1
  719. 7190    I=1
  720. 7200    WHILE Divisor1<>0
  721. 7210      IF I>=MAXLEN(Str$) THEN GOTO Length_err
  722. 7220      Str$[I;1]=FNGetval$(Divisor1 MOD Base)
  723. 7230      I=I+1
  724. 7240      Divisor1=Divisor1 DIV Base
  725. 7250    END WHILE
  726. 7260    Str$=REV$(Str$)
  727. 7270    Divisor2=(Value-Value DIV 1)
  728. 7280    I=1
  729. 7290    IF Divisor2<>0 THEN
  730. 7300      Str2$[I;1]="."
  731. 7310      I=I+1
  732. 7320    END IF
  733. 7330    WHILE Divisor2<>0
  734. 7340      Divisor2=Divisor2*Base
  735. 7350      Str2$[I;1]=FNGetval$(Divisor2 DIV 1)
  736. 7360      Divisor2=Divisor2-Divisor2 DIV 1
  737. 7370      I=I+1
  738. 7380      IF I>MAXLEN(Str2$) THEN Divisor2=0
  739. 7390    END WHILE
  740. 7400    IF LEN(Str$)+LEN(Str2$)>MAXLEN(Str$) THEN GOTO Length_err
  741. 7410    Str$=Str$&Str2$
  742. 7420    IF Sign=1 THEN
  743. 7430      Value=-Value
  744. 7440      Twos_comp(Base,Str$)
  745. 7450    END IF
  746. 7460    IF Value=0 THEN Str$="0"
  747. 7470    SUBEXIT
  748. 7480 Length_err: !
  749. 7490    Error=1
  750. 7500    IF Sign=1 THEN Value=-Value
  751. 7510  SUBEND
  752. 7520  SUB Get_dispval(@Disp,Src_base,Value)
  753. 7530    DIM Str$[64]
  754. 7540    STATUS @Disp;RETURN ("VALUE":Str$)
  755. 7550    IF Dest_base<>10 THEN
  756. 7560      Basetoten(Src_base,Value,Str$)
  757. 7570    ELSE
  758. 7580      Value=VAL(Str$)
  759. 7590    END IF
  760. 7600  SUBEND
  761. 7610  SUB Set_dispval(@Disp,Dest_base,Value)
  762. 7620    DIM Value$[64]
  763. 7630    IF Dest_base<>10 THEN
  764. 7640      Tentobase(Dest_base,Value,Value$,Error)
  765. 7650    ELSE
  766. 7660      Value$=VAL$(Value)
  767. 7670    END IF
  768. 7680    IF Error=0 THEN
  769. 7690      CONTROL @Disp;SET ("VALUE":Value$)
  770. 7700    ELSE
  771. 7710      CONTROL @Disp;SET ("VALUE":"ERROR: Value out of range.")
  772. 7720      WAIT 3
  773. 7730      CONTROL @Disp;SET ("VALUE":0)
  774. 7740    END IF
  775. 7750  SUBEND
  776. 7760  SUB Twos_comp(Base,Str$)
  777. 7770    DIM Tmpstr$[64]
  778. 7780    Tmpstr$=RPT$(FNGetval$(Base-1),64)
  779. 7790    FOR I=1 TO LEN(Str$)
  780. 7800      IF Str$[I;1]<>"." THEN
  781. 7810        Tmpstr$[MAXLEN(Str$)-LEN(Str$)+I]=FNGetval$(Base-FNGetval(Str$[I;1])-1)
  782. 7820      ELSE
  783. 7830        Tmpstr$[MAXLEN(Str$)-LEN(Str$)+I]=Str$[I;1]
  784. 7840      END IF
  785. 7850    NEXT I
  786. 7860    Carry=1
  787. 7870    Str$=""
  788. 7880    FOR I=MAXLEN(Tmpstr$) TO 1 STEP -1
  789. 7890      IF Tmpstr$[I;1]<>"." THEN
  790. 7900        Num=FNGetval(Tmpstr$[I;1])
  791. 7910        Nextnum=(Num+Carry) MOD Base
  792. 7920        Str$=FNGetval$(Nextnum)&Str$
  793. 7930        Carry=(Num+Carry) DIV Base
  794. 7940        IF Carry=0 THEN GOTO Bail_out
  795. 7950      ELSE
  796. 7960        Str$="."&Str$
  797. 7970      END IF
  798. 7980    NEXT I
  799. 7990    SUBEXIT
  800. 8000 Bail_out: Str$=Tmpstr$[1,I-1]&Str$
  801. 8010  SUBEND
  802. 8020  SUB Modval(Val$,Value,OPTIONAL Str$)
  803. 8030    IF NPAR>2 THEN
  804. 8040      IF Val$="0" THEN Val$=""
  805. 8050      Val$=Val$&Str$
  806. 8060    ELSE
  807. 8070      IF Val$="0" THEN Val$=""
  808. 8080      Val$=Val$&VAL$(Value)
  809. 8090    END IF
  810. 8100  SUBEND
  811.